home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fscompr / fscomprf.ctl < prev    next >
Text File  |  1997-12-24  |  8KB  |  306 lines
  1. VERSION 5.00
  2. Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
  3. Begin VB.UserControl FSComprFile 
  4.    ClientHeight    =   585
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3690
  8.    ScaleHeight     =   585
  9.    ScaleWidth      =   3690
  10.    ToolboxBitmap   =   "FSComprFile.ctx":0000
  11.    Begin VB.Timer Timer1 
  12.       Enabled         =   0   'False
  13.       Interval        =   200
  14.       Left            =   960
  15.       Top             =   120
  16.    End
  17.    Begin ComctlLib.ProgressBar pbStatus 
  18.       Height          =   375
  19.       Left            =   120
  20.       TabIndex        =   0
  21.       Top             =   120
  22.       Width           =   3015
  23.       _ExtentX        =   5318
  24.       _ExtentY        =   661
  25.       _Version        =   327682
  26.       Appearance      =   1
  27.    End
  28. End
  29. Attribute VB_Name = "FSComprFile"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = True
  32. Attribute VB_PredeclaredId = False
  33. Attribute VB_Exposed = True
  34. Option Explicit
  35.  
  36. Enum fsCompressionLevel
  37.     fsCmpNoCompression
  38.     fsCmpFastest
  39.     fsCmpLev2
  40.     fsCmpLev3
  41.     fsCmpLev4
  42.     fsCmpLev5
  43.     fsCmpDefault
  44.     fsCmpLev7
  45.     fsCmpLev8
  46.     fsCmpMaximum
  47. End Enum
  48.  
  49. Enum fsResultStatus
  50.     
  51.     ' ZLIB specific
  52.     fsResOk = 0
  53.     
  54.     fsResErrno = -1
  55.     fsResStreamError = -2
  56.     fsResDataError = -3
  57.     fsResMemError = -4
  58.     fsResBufError = -5
  59.     fsResVersionError = -6
  60.     
  61.     ' FSZlib specific
  62.     fsResErrInputFile = -200    '
  63.     fsResErrOutputFile = -201
  64.     fsResErrBackupFile = -202       ' error opening file to backup
  65.     
  66.     ' OCX specific
  67.     fsResMissingInputFileName = -1500
  68.     fsResMissingOutputFileName = -1501
  69. '    fsResMissingBackupFileName = -1502
  70.     
  71. '    fsResMissingDisk = -1503
  72. '    fsResReadOnlyDisk = -1504
  73. '    fsGenericRemovableDiskError = -1505
  74.     
  75.  
  76. End Enum
  77.  
  78. ' current percent
  79. Private PerCent As Integer
  80.  
  81. Private InFile As String, OutFile As String
  82. Private Lev As fsCompressionLevel
  83.  
  84. 'Private BackFile As String, BackDrive As String
  85.  
  86.  
  87. ' result of last action
  88. Private pResultStatus As fsResultStatus
  89.  
  90. ' EVENTS ---------------------------------
  91.  
  92. 'Public Event AskForDisk(DiskNo As Integer)
  93.  
  94.  
  95. Private Sub UserControl_Initialize()
  96. '    pbStatus.Value = 100
  97.  
  98. End Sub
  99.  
  100. Private Sub UserControl_Resize()
  101.     pbStatus.Move 0, 0, ScaleWidth, ScaleHeight
  102.  
  103. End Sub
  104.  
  105. Public Property Get Value() As Integer
  106. Attribute Value.VB_Description = "Position of the progress bar (between 0 and 100)"
  107.     Value = pbStatus.Value
  108. End Property
  109.  
  110.  
  111. Public Property Let Value( _
  112.             ByVal NewValue As Integer)
  113.     pbStatus.Value = NewValue
  114.     PropertyChanged "Value"
  115. End Property
  116.  
  117.  
  118. Private Sub Timer1_Timer()
  119.     If PerCent <> modCompress.gPerCent Then
  120.         PerCent = modCompress.gPerCent
  121.         pbStatus.Value = PerCent
  122.     End If
  123. End Sub
  124.  
  125. Private Sub UserControl_InitProperties()
  126.     Level = fsCmpDefault
  127.     InputFile = ""
  128.     OutputFile = ""
  129. '    BackupFile = ""
  130. '    BackupDrive = "A:"
  131. End Sub
  132.  
  133. Public Sub Compress()
  134.     If Trim$(OutFile) = "" Then
  135.         pResultStatus = fsResMissingOutputFileName
  136.         Exit Sub
  137.     End If
  138.     If Trim$(InFile) = "" Then
  139.         pResultStatus = fsResMissingInputFileName
  140.         Exit Sub
  141.     End If
  142.     PerCent = 0
  143.     pbStatus.Value = 0
  144.     Timer1.Enabled = True
  145.     pResultStatus = CompressFile(OutFile, InFile, Lev)
  146.     Timer1.Enabled = False
  147.     PerCent = 0
  148.     pbStatus.Value = 0
  149. End Sub
  150.  
  151. Public Sub Decompress()
  152.     If Trim$(OutFile) = "" Then
  153.         pResultStatus = fsResMissingOutputFileName
  154.         Exit Sub
  155.     End If
  156.     If Trim$(InFile) = "" Then
  157.         pResultStatus = fsResMissingInputFileName
  158.         Exit Sub
  159.     End If
  160.     PerCent = 0
  161.     pbStatus.Value = 0
  162.     Timer1.Enabled = True
  163.     pResultStatus = DecompressFile(OutFile, InFile)
  164.     Timer1.Enabled = False
  165.     PerCent = 0
  166.     pbStatus.Value = 0
  167. End Sub
  168.  
  169. Public Property Get InputFile() As String
  170. Attribute InputFile.VB_Description = "Path of the file to be compressed (by Compress) or decompressed (by Decompress)"
  171. Attribute InputFile.VB_ProcData.VB_Invoke_Property = ";Compression"
  172.     InputFile = InFile
  173. End Property
  174.  
  175. Public Property Let InputFile(ByVal vNewInputFile As String)
  176.     InFile = vNewInputFile
  177.     PropertyChanged "InputFile"
  178.  
  179. End Property
  180.  
  181. Public Property Get OutputFile() As String
  182. Attribute OutputFile.VB_Description = "Path of the compressed file (by Compress) of decompressed file (by Decompress)"
  183. Attribute OutputFile.VB_ProcData.VB_Invoke_Property = ";Compression"
  184.     OutputFile = OutFile
  185. End Property
  186.  
  187. Public Property Let OutputFile(ByVal vNewOutputFile As String)
  188.     OutFile = vNewOutputFile
  189.     PropertyChanged "OutputFile"
  190.  
  191. End Property
  192.  
  193. 'Public Property Get BackupFile() As String
  194. '    BackupFile = BackFile
  195. 'End Property
  196.  
  197. 'Public Property Let BackupFile(ByVal vNewBackupFile As String)
  198. '    BackFile = vNewBackupFile
  199. '    PropertyChanged "BackupFile"
  200.  
  201. 'End Property
  202.  
  203. 'Public Property Get BackupDrive() As String
  204. '    BackupDrive = BackDrive
  205. 'End Property
  206.  
  207. 'Public Property Let BackupDrive(ByVal vNewBackDrive As String)
  208. '    BackDrive = vNewBackDrive
  209. '    PropertyChanged "BackupDrive"
  210.  
  211. 'End Property
  212.  
  213. Public Property Get Level() As fsCompressionLevel
  214. Attribute Level.VB_Description = "Compression level (0-9)"
  215. Attribute Level.VB_ProcData.VB_Invoke_Property = ";Compression"
  216.     Level = Lev
  217. End Property
  218.  
  219. Public Property Let Level(ByVal vNewValue As fsCompressionLevel)
  220.     Lev = vNewValue
  221.     PropertyChanged "Level"
  222. End Property
  223.  
  224. Public Property Get ResultStatus() As fsResultStatus
  225. Attribute ResultStatus.VB_Description = "Result of the last operation (0 = OK)"
  226. Attribute ResultStatus.VB_ProcData.VB_Invoke_Property = ";Compression"
  227.     ResultStatus = pResultStatus
  228. End Property
  229.  
  230.  
  231. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  232.     PropBag.WriteProperty "Level", Level, 6
  233.     PropBag.WriteProperty "InputFile", InputFile, ""
  234.     PropBag.WriteProperty "OutputFile", OutputFile, ""
  235. '    PropBag.WriteProperty "BackupFile", BackupFile, ""
  236. '    PropBag.WriteProperty "BackupDrive", BackupDrive, "A:"
  237.     
  238. End Sub
  239.  
  240. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  241.     Level = PropBag.ReadProperty("Level", 6)
  242.     InputFile = PropBag.ReadProperty("InputFile", "")
  243.     OutputFile = PropBag.ReadProperty("OutputFile", "")
  244. '    BackupFile = PropBag.ReadProperty("BackupFile", "")
  245. '    BackupDrive = PropBag.ReadProperty("BackupDrive", "A:")
  246. End Sub
  247.  
  248. Public Sub ShowAboutBox()
  249. Attribute ShowAboutBox.VB_UserMemId = -552
  250.     dlgInfo.Show vbModal
  251.     Unload dlgInfo
  252.     Set dlgInfo = Nothing
  253. End Sub
  254.     
  255.  
  256. 'Public Sub Backup()
  257. '    ' backups a file to one or more removable disks disks
  258. '    Dim Remaining As Long, ToProcess As Long
  259. '
  260. '    If Trim$(BackFile) = "" Then
  261. '        pResultStatus = fsResMissingBackupFileName
  262. '        Exit Sub
  263. '    End If
  264. '
  265. '    ' ask for disk
  266. '    RaiseEvent AskForDisk(1)
  267. '
  268. '    ' wipes the disk
  269. '
  270. '
  271. '
  272. '    ' opens the file
  273. '    On Error Resume Next
  274. '    Open BackFile For Binary As #1
  275. '    If Err.Number <> 0 Then
  276. '        pResultStatus = fsResErrBackupFile
  277. '        Exit Sub
  278. '    End If
  279. '
  280. '    Remaining = LOF(1)
  281. '
  282. '
  283. '
  284. 'End Sub
  285.  
  286. Public Property Get Appearance() As AppearanceConstants
  287. Attribute Appearance.VB_ProcData.VB_Invoke_Property = ";Aspetto"
  288.     Appearance = pbStatus.Appearance
  289. End Property
  290.  
  291. Public Property Let Appearance(ByVal vNewValue As AppearanceConstants)
  292.     pbStatus.Appearance = vNewValue
  293.     PropertyChanged "Appearance"
  294. End Property
  295.  
  296. Public Property Get BorderStyle() As ComctlLib.BorderStyleConstants
  297. Attribute BorderStyle.VB_ProcData.VB_Invoke_Property = ";Aspetto"
  298.     BorderStyle = pbStatus.BorderStyle
  299. End Property
  300.  
  301. Public Property Let BorderStyle(ByVal vNewValue As ComctlLib.BorderStyleConstants)
  302.     pbStatus.BorderStyle = vNewValue
  303.     PropertyChanged "BorderStyle"
  304. End Property
  305.  
  306.